Graph mining II: analysis and modeling

Dobre Bogdan-Mihai, Moldovan George, Mocanu Alexandru

04 decembrie 2020

Capitolul 1

library(statnet)
## Loading required package: tergm
## Loading required package: ergm
## Loading required package: network
## network: Classes for Relational Data
## Version 1.16.1 created on 2020-10-06.
## copyright (c) 2005, Carter T. Butts, University of California-Irvine
##                     Mark S. Handcock, University of California -- Los Angeles
##                     David R. Hunter, Penn State University
##                     Martina Morris, University of Washington
##                     Skye Bender-deMoll, University of Washington
##  For citation information, type citation("network").
##  Type help("network-package") to get started.
## 
## ergm: version 3.11.0, created on 2020-10-14
## Copyright (c) 2020, Mark S. Handcock, University of California -- Los Angeles
##                     David R. Hunter, Penn State University
##                     Carter T. Butts, University of California -- Irvine
##                     Steven M. Goodreau, University of Washington
##                     Pavel N. Krivitsky, UNSW Sydney
##                     Martina Morris, University of Washington
##                     with contributions from
##                     Li Wang
##                     Kirk Li, University of Washington
##                     Skye Bender-deMoll, University of Washington
##                     Chad Klumb
##                     Michał Bojanowski, Kozminski University
##                     Ben Bolker
## Based on "statnet" project software (statnet.org).
## For license and citation information see statnet.org/attribution
## or type citation("ergm").
## NOTE: Versions before 3.6.1 had a bug in the implementation of the bd()
## constraint which distorted the sampled distribution somewhat. In
## addition, Sampson's Monks datasets had mislabeled vertices. See the
## NEWS and the documentation for more details.
## NOTE: Some common term arguments pertaining to vertex attribute and
## level selection have changed in 3.10.0. See terms help for more
## details. Use 'options(ergm.term=list(version="3.9.4"))' to use old
## behavior.
## Loading required package: networkDynamic
## 
## networkDynamic: version 0.10.1, created on 2020-01-16
## Copyright (c) 2020, Carter T. Butts, University of California -- Irvine
##                     Ayn Leslie-Cook, University of Washington
##                     Pavel N. Krivitsky, University of Wollongong
##                     Skye Bender-deMoll, University of Washington
##                     with contributions from
##                     Zack Almquist, University of California -- Irvine
##                     David R. Hunter, Penn State University
##                     Li Wang
##                     Kirk Li, University of Washington
##                     Steven M. Goodreau, University of Washington
##                     Jeffrey Horner
##                     Martina Morris, University of Washington
## Based on "statnet" project software (statnet.org).
## For license and citation information see statnet.org/attribution
## or type citation("networkDynamic").
## 
## tergm: version 3.7.0, created on 2020-10-15
## Copyright (c) 2020, Pavel N. Krivitsky, UNSW Sydney
##                     Mark S. Handcock, University of California -- Los Angeles
##                     with contributions from
##                     David R. Hunter, Penn State University
##                     Steven M. Goodreau, University of Washington
##                     Martina Morris, University of Washington
##                     Nicole Bohme Carnegie, New York University
##                     Carter T. Butts, University of California -- Irvine
##                     Ayn Leslie-Cook, University of Washington
##                     Skye Bender-deMoll
##                     Li Wang
##                     Kirk Li, University of Washington
##                     Chad Klumb
## Based on "statnet" project software (statnet.org).
## For license and citation information see statnet.org/attribution
## or type citation("tergm").
## Loading required package: ergm.count
## 
## ergm.count: version 3.4.0, created on 2019-05-15
## Copyright (c) 2019, Pavel N. Krivitsky, University of Wollongong
##                     with contributions from
##                     Mark S. Handcock, University of California -- Los Angeles
##                     David R. Hunter, Penn State University
## Based on "statnet" project software (statnet.org).
## For license and citation information see statnet.org/attribution
## or type citation("ergm.count").
## NOTE: The form of the term 'CMP' has been changed in version 3.2 of
## 'ergm.count'. See the news or help('CMP') for more information.
## Loading required package: sna
## Loading required package: statnet.common
## 
## Attaching package: 'statnet.common'
## The following object is masked from 'package:base':
## 
##     order
## sna: Tools for Social Network Analysis
## Version 2.6 created on 2020-10-5.
## copyright (c) 2005, Carter T. Butts, University of California-Irvine
##  For citation information, type citation("sna").
##  Type help(package="sna") to get started.
## Loading required package: tsna
## 
## statnet: version 2019.6, created on 2019-06-13
## Copyright (c) 2019, Mark S. Handcock, University of California -- Los Angeles
##                     David R. Hunter, Penn State University
##                     Carter T. Butts, University of California -- Irvine
##                     Steven M. Goodreau, University of Washington
##                     Pavel N. Krivitsky, University of Wollongong
##                     Skye Bender-deMoll
##                     Martina Morris, University of Washington
## Based on "statnet" project software (statnet.org).
## For license and citation information see statnet.org/attribution
## or type citation("statnet").
library(RColorBrewer)
library(network)

netmat <- rbind(c(1,2),
                c(1,3),
                c(2,3),
                c(1,4),
                c(5,6),
                c(7,8),
                c(5,7),
                c(5,8),
                c(5,9),
                c(6,7),
                c(6,8),
                c(6,9),
                c(5,10),
                c(6,10),
                c(11,12),
                c(11,13),
                c(13,14),
                c(14,19),
                c(13,19),
                c(14,1),
                c(19,15),
                c(19,16),
                c(19,17),
                c(19,18),
                c(12,15),
                c(12,16),
                c(12,17),
                c(12,18),
                c(20,8),
                c(20,9),
                c(21,8),
                c(21,9),
                c(3,8),
                c(3,9),
                c(1,8),
                c(1,9))


net <- network(netmat, matrix.type="edgelist")
netmatsym <- symmetrize(as.sociomatrix(net), rule ="weak")


netsym <- network(netmatsym, matrix.type="adjacency")
network.vertex.names(netsym) <- c("B***cu L***na", 
                                  "B***cu An***us", 
                                  "B**scu C***nel",
                                  "B**hiu G***ge",
                                  "M**tu M**na",
                                  "Ma**u I***he",
                                  "T**a F**p",
                                  "T**a G***ghe",
                                  "S**m An**la",
                                  "G**ca G****ghe",
                                  "C**u I**n",
                                  "M***u L**do",
                                  "D**a D**a",
                                  "D**a C**l",
                                  "N**cu P**u",
                                  "N**se T**er",
                                  "S***an C***tin",
                                  "O***u A**ei",
                                  "D**a I***l",
                                  "P**ci V***e",
                                  "D***mir R**a")
set.vertex.attribute(netsym, "role", c("C", 
                                       "C", 
                                       "C",
                                       "CR",
                                       "C",
                                       "C",
                                       "CT",
                                       "CT",
                                       "CT",
                                       "C",
                                       "C",
                                       "A",
                                       "A",
                                       "C",
                                       "C",
                                       "C",
                                       "C",
                                       "C",
                                       "CT",
                                       "D",
                                       "D"))
# C : Comerciant, CR : Cartita, CT: contrabandist, A: aducator clienti, D: depozitare
set.vertex.attribute(netsym, "abrev_name", c("BL", 
                                             "BA",
                                             "BC",
                                             "BG",
                                             "MM",
                                             "MI",
                                             "TF",
                                             "TG",
                                             "SA",
                                             "GG",
                                             "CI",
                                             "ML",
                                             "DD",
                                             "DC",
                                             "NP",
                                             "NT",
                                             "SC",
                                             "OA",
                                             "DI",
                                             "PV",
                                             "DR"))
netsym %v% "alldeg" <- degree(netsym)
summary(netsym)
## Network attributes:
##   vertices = 21
##   directed = TRUE
##   hyper = FALSE
##   loops = FALSE
##   multiple = FALSE
##   bipartite = FALSE
##  total edges = 72 
##    missing edges = 0 
##    non-missing edges = 72 
##  density = 0.1714286 
## 
## Vertex attributes:
## 
##  abrev_name:
##    character valued attribute
##    attribute summary:
##    the 10 most common values are:
## BA BC BG BL CI DC DD DI DR GG 
##  1  1  1  1  1  1  1  1  1  1 
## 
##  alldeg:
##    numeric valued attribute
##    attribute summary:
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   2.000   4.000   6.000   6.857  10.000  14.000 
## 
##  role:
##    character valued attribute
##    attribute summary:
##  A  C CR CT  D 
##  2 12  1  4  2 
##   vertex.names:
##    character valued attribute
##    21 valid vertex names
## 
## No edge attributes
## 
## Network edgelist matrix:
##       [,1] [,2]
##  [1,]    2    1
##  [2,]    3    1
##  [3,]    4    1
##  [4,]    8    1
##  [5,]    9    1
##  [6,]   14    1
##  [7,]    1    2
##  [8,]    3    2
##  [9,]    1    3
## [10,]    2    3
## [11,]    8    3
## [12,]    9    3
## [13,]    1    4
## [14,]    6    5
## [15,]    7    5
## [16,]    8    5
## [17,]    9    5
## [18,]   10    5
## [19,]    5    6
## [20,]    7    6
## [21,]    8    6
## [22,]    9    6
## [23,]   10    6
## [24,]    5    7
## [25,]    6    7
## [26,]    8    7
## [27,]    1    8
## [28,]    3    8
## [29,]    5    8
## [30,]    6    8
## [31,]    7    8
## [32,]   20    8
## [33,]   21    8
## [34,]    1    9
## [35,]    3    9
## [36,]    5    9
## [37,]    6    9
## [38,]   20    9
## [39,]   21    9
## [40,]    5   10
## [41,]    6   10
## [42,]   12   11
## [43,]   13   11
## [44,]   11   12
## [45,]   15   12
## [46,]   16   12
## [47,]   17   12
## [48,]   18   12
## [49,]   11   13
## [50,]   14   13
## [51,]   19   13
## [52,]    1   14
## [53,]   13   14
## [54,]   19   14
## [55,]   12   15
## [56,]   19   15
## [57,]   12   16
## [58,]   19   16
## [59,]   12   17
## [60,]   19   17
## [61,]   12   18
## [62,]   19   18
## [63,]   13   19
## [64,]   14   19
## [65,]   15   19
## [66,]   16   19
## [67,]   17   19
## [68,]   18   19
## [69,]    8   20
## [70,]    9   20
## [71,]    8   21
## [72,]    9   21
namelab <- get.vertex.attribute(netsym, "vertex.names")
rolelab <- get.vertex.attribute(netsym, "role")
abrevnamelab <-get.vertex.attribute(netsym, "abrev_name")
my_pal <- brewer.pal(5,"Dark2")
rolecat <- as.factor(get.vertex.attribute(netsym,"role"))
plot(netsym,
     main = "Infractional network",
     usearrows=FALSE, 
     mode="fruchtermanreingold", 
     vertex.col = my_pal[rolecat],
     label=rolelab,
     displaylabels=T,
     vertex.cex = 1.5)

Capitolul 2

print("BASIC CHARACTERISTICS")
## [1] "BASIC CHARACTERISTICS"
print("Size:")
## [1] "Size:"
print(network.size(netsym))
## [1] 21
print("Density:")
## [1] "Density:"
print(gden(netsym))
## [1] 0.1714286
print("Components:")
## [1] "Components:"
print(components(netsym))
## [1] 1
print("Diameter:")
## [1] "Diameter:"
gd <- geodist(netsym)
print(max(gd$gdist))
## [1] 7
print("Transitivity:")
## [1] "Transitivity:"
print(gtrans(netsym, mode="graph"))
## [1] 0.25

Capitolul 3

print("DIFFERENT REPRESENTATIONS")
## [1] "DIFFERENT REPRESENTATIONS"
print("Sociomatrix:")
## [1] "Sociomatrix:"
print(as.sociomatrix(netsym))
##                B***cu L***na B***cu An***us B**scu C***nel B**hiu G***ge
## B***cu L***na              0              1              1             1
## B***cu An***us             1              0              1             0
## B**scu C***nel             1              1              0             0
## B**hiu G***ge              1              0              0             0
## M**tu M**na                0              0              0             0
## Ma**u I***he               0              0              0             0
## T**a F**p                  0              0              0             0
## T**a G***ghe               1              0              1             0
## S**m An**la                1              0              1             0
## G**ca G****ghe             0              0              0             0
## C**u I**n                  0              0              0             0
## M***u L**do                0              0              0             0
## D**a D**a                  0              0              0             0
## D**a C**l                  1              0              0             0
## N**cu P**u                 0              0              0             0
## N**se T**er                0              0              0             0
## S***an C***tin             0              0              0             0
## O***u A**ei                0              0              0             0
## D**a I***l                 0              0              0             0
## P**ci V***e                0              0              0             0
## D***mir R**a               0              0              0             0
##                M**tu M**na Ma**u I***he T**a F**p T**a G***ghe S**m An**la
## B***cu L***na            0            0         0            1           1
## B***cu An***us           0            0         0            0           0
## B**scu C***nel           0            0         0            1           1
## B**hiu G***ge            0            0         0            0           0
## M**tu M**na              0            1         1            1           1
## Ma**u I***he             1            0         1            1           1
## T**a F**p                1            1         0            1           0
## T**a G***ghe             1            1         1            0           0
## S**m An**la              1            1         0            0           0
## G**ca G****ghe           1            1         0            0           0
## C**u I**n                0            0         0            0           0
## M***u L**do              0            0         0            0           0
## D**a D**a                0            0         0            0           0
## D**a C**l                0            0         0            0           0
## N**cu P**u               0            0         0            0           0
## N**se T**er              0            0         0            0           0
## S***an C***tin           0            0         0            0           0
## O***u A**ei              0            0         0            0           0
## D**a I***l               0            0         0            0           0
## P**ci V***e              0            0         0            1           1
## D***mir R**a             0            0         0            1           1
##                G**ca G****ghe C**u I**n M***u L**do D**a D**a D**a C**l
## B***cu L***na               0         0           0         0         1
## B***cu An***us              0         0           0         0         0
## B**scu C***nel              0         0           0         0         0
## B**hiu G***ge               0         0           0         0         0
## M**tu M**na                 1         0           0         0         0
## Ma**u I***he                1         0           0         0         0
## T**a F**p                   0         0           0         0         0
## T**a G***ghe                0         0           0         0         0
## S**m An**la                 0         0           0         0         0
## G**ca G****ghe              0         0           0         0         0
## C**u I**n                   0         0           1         1         0
## M***u L**do                 0         1           0         0         0
## D**a D**a                   0         1           0         0         1
## D**a C**l                   0         0           0         1         0
## N**cu P**u                  0         0           1         0         0
## N**se T**er                 0         0           1         0         0
## S***an C***tin              0         0           1         0         0
## O***u A**ei                 0         0           1         0         0
## D**a I***l                  0         0           0         1         1
## P**ci V***e                 0         0           0         0         0
## D***mir R**a                0         0           0         0         0
##                N**cu P**u N**se T**er S***an C***tin O***u A**ei D**a I***l
## B***cu L***na           0           0              0           0          0
## B***cu An***us          0           0              0           0          0
## B**scu C***nel          0           0              0           0          0
## B**hiu G***ge           0           0              0           0          0
## M**tu M**na             0           0              0           0          0
## Ma**u I***he            0           0              0           0          0
## T**a F**p               0           0              0           0          0
## T**a G***ghe            0           0              0           0          0
## S**m An**la             0           0              0           0          0
## G**ca G****ghe          0           0              0           0          0
## C**u I**n               0           0              0           0          0
## M***u L**do             1           1              1           1          0
## D**a D**a               0           0              0           0          1
## D**a C**l               0           0              0           0          1
## N**cu P**u              0           0              0           0          1
## N**se T**er             0           0              0           0          1
## S***an C***tin          0           0              0           0          1
## O***u A**ei             0           0              0           0          1
## D**a I***l              1           1              1           1          0
## P**ci V***e             0           0              0           0          0
## D***mir R**a            0           0              0           0          0
##                P**ci V***e D***mir R**a
## B***cu L***na            0            0
## B***cu An***us           0            0
## B**scu C***nel           0            0
## B**hiu G***ge            0            0
## M**tu M**na              0            0
## Ma**u I***he             0            0
## T**a F**p                0            0
## T**a G***ghe             1            1
## S**m An**la              1            1
## G**ca G****ghe           0            0
## C**u I**n                0            0
## M***u L**do              0            0
## D**a D**a                0            0
## D**a C**l                0            0
## N**cu P**u               0            0
## N**se T**er              0            0
## S***an C***tin           0            0
## O***u A**ei              0            0
## D**a I***l               0            0
## P**ci V***e              0            0
## D***mir R**a             0            0
print("Edge list:")
## [1] "Edge list:"
print(as.matrix(netsym, matrix.type="edgelist"))
##       [,1] [,2]
##  [1,]    2    1
##  [2,]    3    1
##  [3,]    4    1
##  [4,]    8    1
##  [5,]    9    1
##  [6,]   14    1
##  [7,]    1    2
##  [8,]    3    2
##  [9,]    1    3
## [10,]    2    3
## [11,]    8    3
## [12,]    9    3
## [13,]    1    4
## [14,]    6    5
## [15,]    7    5
## [16,]    8    5
## [17,]    9    5
## [18,]   10    5
## [19,]    5    6
## [20,]    7    6
## [21,]    8    6
## [22,]    9    6
## [23,]   10    6
## [24,]    5    7
## [25,]    6    7
## [26,]    8    7
## [27,]    1    8
## [28,]    3    8
## [29,]    5    8
## [30,]    6    8
## [31,]    7    8
## [32,]   20    8
## [33,]   21    8
## [34,]    1    9
## [35,]    3    9
## [36,]    5    9
## [37,]    6    9
## [38,]   20    9
## [39,]   21    9
## [40,]    5   10
## [41,]    6   10
## [42,]   12   11
## [43,]   13   11
## [44,]   11   12
## [45,]   15   12
## [46,]   16   12
## [47,]   17   12
## [48,]   18   12
## [49,]   11   13
## [50,]   14   13
## [51,]   19   13
## [52,]    1   14
## [53,]   13   14
## [54,]   19   14
## [55,]   12   15
## [56,]   19   15
## [57,]   12   16
## [58,]   19   16
## [59,]   12   17
## [60,]   19   17
## [61,]   12   18
## [62,]   19   18
## [63,]   13   19
## [64,]   14   19
## [65,]   15   19
## [66,]   16   19
## [67,]   17   19
## [68,]   18   19
## [69,]    8   20
## [70,]    9   20
## [71,]    8   21
## [72,]    9   21
## attr(,"n")
## [1] 21
## attr(,"vnames")
##  [1] "B***cu L***na"  "B***cu An***us" "B**scu C***nel" "B**hiu G***ge" 
##  [5] "M**tu M**na"    "Ma**u I***he"   "T**a F**p"      "T**a G***ghe"  
##  [9] "S**m An**la"    "G**ca G****ghe" "C**u I**n"      "M***u L**do"   
## [13] "D**a D**a"      "D**a C**l"      "N**cu P**u"     "N**se T**er"   
## [17] "S***an C***tin" "O***u A**ei"    "D**a I***l"     "P**ci V***e"   
## [21] "D***mir R**a"
print("Filtering networks")
## [1] "Filtering networks"
print(get.vertex.attribute(netsym, "role"))
##  [1] "C"  "C"  "C"  "CR" "C"  "C"  "CT" "CT" "CT" "C"  "C"  "A"  "A"  "C"  "C" 
## [16] "C"  "C"  "C"  "CT" "D"  "D"
comercianti <- get.inducedSubgraph(netsym, which (netsym %v% "role"=="C"))
gplot(comercianti,displaylabels=TRUE, main="Comercianti")

delete.vertices(comercianti, isolates(comercianti))
gplot(comercianti, displaylabels = TRUE, main="Grupuri de comercianti")

Capitolul 4

gplot(netsym,gmode="graph",edge.col="grey75",displaylabels=T,
      vertex.cex=1.5,mode='circle',main="circle")

gplot(netsym,gmode="graph",edge.col="grey75",displaylabels=T,
      vertex.cex=1.5,mode='eigen',main="eigen")

gplot(netsym,gmode="graph",edge.col="grey75",displaylabels=T,
      vertex.cex=1.5,mode='random',main="random")

gplot(netsym,gmode="graph",edge.col="grey75",displaylabels=T,
      vertex.cex=1.5,mode='spring',main="spring")

gplot(netsym,gmode="graph",edge.col="grey75",displaylabels=T,
      vertex.cex=1.5,mode='fruchtermanreingold',main='fruchtermanreingold')

gplot(netsym,gmode="graph",edge.col="grey75",displaylabels=T,
      vertex.cex=1.5,mode='kamadakawai',
      main='kamadakawai')

Capitolul 5

library(network)

library(intergraph)
library(igraph)
## 
## Attaching package: 'igraph'
## The following objects are masked from 'package:sna':
## 
##     betweenness, bonpow, closeness, components, degree, dyad.census,
##     evcent, hierarchy, is.connected, neighborhood, triad.census
## The following objects are masked from 'package:network':
## 
##     %c%, %s%, add.edges, add.vertices, delete.edges, delete.vertices,
##     get.edge.attribute, get.edges, get.vertex.attribute, is.bipartite,
##     is.directed, list.edge.attributes, list.vertex.attributes,
##     set.edge.attribute, set.vertex.attribute
## The following objects are masked from 'package:stats':
## 
##     decompose, spectrum
## The following object is masked from 'package:base':
## 
##     union
library(networkD3)
plot(netsym,vertex.cex=0.5,main="Too small nodes")

plot(netsym,vertex.cex=6,main="Too large nodes")

plot(netsym,vertex.cex=2,main="Just right node size")

sidenum <- 3:7
rolecat <- as.factor(get.vertex.attribute(asIgraph(netsym),"role"))
plot(netsym,usearrows=FALSE,vertex.cex=4, main="Different node type",
     displaylabels=F,vertex.sides=sidenum[rolecat])

n_edge <- network.edgecount(netsym)
linecol_pal <- c("blue","red","green")
edge_cat <- sample(1:3,n_edge,replace=T)
plot(netsym,vertex.cex=1.5,vertex.col="grey25", main="Edge coloring example",
     edge.col=linecol_pal[edge_cat],edge.lwd=2)

widths <- c(2,6,10)
plot(netsym,vertex.cex=1.5,main="Different edge width",
     edge.lwd=1.5*widths)

n_edge <- network.edgecount(netsym)
edge_cat <- sample(1:3,n_edge,replace=T)
line_pal <- c(2,3,4)
gplot(netsym,vertex.cex=0.8,gmode="graph", main="Different edge type",
      vertex.col="gray50",edge.lwd=1.5,
      edge.lty=line_pal[edge_cat])

my_pal <- brewer.pal(5,"Dark2")
rolecat <- as.factor(get.vertex.attribute(asIgraph(netsym),"role"))
plot(netsym,
     main = "Infractional network",
     usearrows=FALSE, 
     mode="fruchtermanreingold", 
     vertex.col = my_pal[rolecat],
     label=abrevnamelab,
     displaylabels=T,
     vertex.cex = 1.5)
legend("bottomleft",legend=c("Aducator clienti","Comerciant","Cartita","Contrabandist","Depozitare"),
       col=my_pal,pch=19,pt.cex=1.5,bty="n",
       title="Criminal Role")

# necessary, caused conflicts
detach("package:statnet", unload=TRUE)

Capitolul 6

Tkplot

inetsym <- asIgraph(netsym)
Coord <- tkplot(inetsym, vertex.size=3,
                vertex.label=V(inetsym)$role,
                vertex.color="darkgreen")
MCoords <- tkplot.getcoords(Coord)
plot(inetsym, layout=MCoords, vertex.size=5,main="Interactive tkplot",
     vertex.label=NA, vertex.color="lightblue")

# NetworkD3
inetsym_edge <- get.edgelist(inetsym)
inetsym_edge <- inetsym_edge - 1
inetsym_edge <- data.frame(inetsym_edge)
print(V(inetsym)$role)
##  [1] "C"  "C"  "C"  "CR" "C"  "C"  "CT" "CT" "CT" "C"  "C"  "A"  "A"  "C"  "C" 
## [16] "C"  "C"  "C"  "CT" "D"  "D"
inetsym_nodes <- data.frame(NodeID=as.numeric(V(inetsym)-1),
                          Group=V(inetsym)$role,
                          Nodesize=(degree(inetsym)))
net_D3 <- forceNetwork(Links = inetsym_edge, Nodes = inetsym_nodes,
             Source = "X1", Target = "X2",
             NodeID = "NodeID",Nodesize = "Nodesize",
             radiusCalculation="Math.sqrt(d.nodesize)*3",
             Group = "Group", opacity = 0.8,
             legend=TRUE)

saveNetwork(net_D3,file = 'Net_test2.html',
            selfcontained=TRUE)


#Visnetwork
library(visNetwork)
inetsym_edge <- get.edgelist(inetsym)
inetsym_edge <- data.frame(from = inetsym_edge[,1],
                         to = inetsym_edge[,2])
inetsym_nodes <- data.frame(id = as.numeric(V(inetsym)))
visNetwork(inetsym_nodes, inetsym_edge, width = "100%")
net <- visNetwork(inetsym_nodes, inetsym_edge,
                  width = "100%",legend=TRUE)
## Warning in visNetwork(inetsym_nodes, inetsym_edge, width = "100%", legend =
## TRUE): 'legend' and 'legend.width' are deprecated (visNetwork >= 0.1.2). Please
## now prefer use visLegend function.
net <- visOptions(net,highlightNearest = TRUE)
net <- visInteraction(net,navigationButtons = TRUE)
library(htmlwidgets)
## 
## Attaching package: 'htmlwidgets'
## The following object is masked from 'package:networkD3':
## 
##     JS
saveWidget(net, "Net_test3.html")

Arcdiagram

install.packages(“devtools”) library(devtools) install_github(“gastonstat/arcdiagram”)

library(arcdiagram) inetsym <- asIgraph(netsym) netsym_edge <- get.edgelist(netsym) arcplot(netsym)

Chord diagram

library(circlize)
## ========================================
## circlize version 0.4.11
## CRAN page: https://cran.r-project.org/package=circlize
## Github page: https://github.com/jokergoo/circlize
## Documentation: https://jokergoo.github.io/circlize_book/book/
## 
## If you use it in published research, please cite:
## Gu, Z. circlize implements and enhances circular visualization
##   in R. Bioinformatics 2014.
## 
## This message can be suppressed by:
##   suppressPackageStartupMessages(library(circlize))
## ========================================
## 
## Attaching package: 'circlize'
## The following object is masked from 'package:igraph':
## 
##     degree
## The following object is masked from 'package:sna':
## 
##     degree
library(statnet)
## 
## statnet: version 2019.6, created on 2019-06-13
## Copyright (c) 2019, Mark S. Handcock, University of California -- Los Angeles
##                     David R. Hunter, Penn State University
##                     Carter T. Butts, University of California -- Irvine
##                     Steven M. Goodreau, University of Washington
##                     Pavel N. Krivitsky, University of Wollongong
##                     Skye Bender-deMoll
##                     Martina Morris, University of Washington
## Based on "statnet" project software (statnet.org).
## For license and citation information see statnet.org/attribution
## or type citation("statnet").
sociomat <- as.sociomatrix(netsym,attrname='passes')
## Warning in as.matrix.network.adjacency(x, attrname = attrname, expand.bipartite
## = expand.bipartite, : There is no edge attribute named passes
chordDiagram(sociomat)

detach("package:statnet", unload=TRUE)
detach("package:circlize", unload=TRUE)

Chapter 7

detach("package:networkD3", unload=TRUE)
detach("package:igraph", unload=TRUE)
print("CENTRALITY DEGREES")
## [1] "CENTRALITY DEGREES"
print(degree(netsym, gmode="graph"))
##  [1] 6 2 4 1 5 5 3 7 6 2 2 5 3 3 2 2 2 2 6 2 2
print(closeness(netsym, gmode="graph"))
##  [1] 0.4761905 0.3333333 0.3846154 0.3278689 0.3278689 0.3278689 0.3174603
##  [8] 0.4166667 0.4081633 0.2531646 0.2941176 0.2564103 0.3636364 0.4444444
## [15] 0.2941176 0.2941176 0.2941176 0.2941176 0.3846154 0.3076923 0.3076923
print(betweenness(netsym, gmode="graph"))
##  [1] 113.1666667   0.0000000   4.1666667   0.0000000   9.6666667   9.6666667
##  [7]   0.0000000  51.0000000  36.0000000   0.0000000   3.6000000   7.0000000
## [13]  16.6000000  96.0000000   2.8500000   2.8500000   2.8500000   2.8500000
## [19]  69.4000000   0.1666667   0.1666667
#Cutpoints
cpnet <- cutpoints(netsym,mode="graph",
                   return.indicator=TRUE)
gplot(netsym,gmode="graph",vertex.col=cpnet+2,coord=MCoords,
      jitter=FALSE,displaylabels=TRUE)

#Bridges
bridges <- function(dat,mode="graph",
                    connected=c("strong", "weak")) {
   e_cnt <- network.edgecount(dat)
   if (mode == "graph") {
      cmp_cnt <- components(dat)
      b_vec <- rep(FALSE,e_cnt)
      for(i in 1:e_cnt){
         dat2 <- dat
         delete.edges(dat2,i)
         b_vec[i] <- (components(dat2) != cmp_cnt)
      }
   }
   else {
      cmp_cnt <- components(dat,connected=connected)
      b_vec <- rep(FALSE,e_cnt)
      for(i in 1:e_cnt){
         dat2 <- dat
         delete.edges(dat2,i)
         b_vec[i] <- (components(dat2) != cmp_cnt)
      }
   }
   return(b_vec)
}
bridges(netsym)
##  [1] FALSE FALSE  TRUE FALSE FALSE  TRUE FALSE FALSE FALSE FALSE FALSE FALSE
## [13]  TRUE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
## [25] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
## [37] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
## [49] FALSE FALSE FALSE  TRUE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
## [61] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
colors <- c("blue", "red")

# Determining the centre nodes using the degree
deg <- degree(netsym, gmode="graph")
plot(netsym,
     usearrows=FALSE, 
     vertex.col = colors[(deg >= 5) + 1],
     label = netsym %v% "abrev_name",
     displaylabels=T,
     vertex.cex = deg/2)

# Determining the centre nodes using the closeness function
cls <- closeness(netsym, gmode="graph")
plot(netsym,
     usearrows=FALSE, 
     vertex.col = colors[(cls >= 0.33) + 1],
     label = netsym %v% "abrev_name",
     displaylabels=T,
     vertex.cex = cls*10)

# Determining the centre nodes using the betweenness function
bet <- betweenness(netsym, gmode="graph")
plot(netsym,
     usearrows=FALSE, 
     vertex.col = colors[(bet >= 90) + 1],
     label = netsym %v% "abrev_name",
     displaylabels=T,
     vertex.cex = sqrt(bet+1))

# Computing the level of correlation between multiple centrality measures
df.prom <- data.frame(
        deg = degree(netsym),
        cls = closeness(netsym),
        btw =  betweenness(netsym),
        evc = evcent(netsym),
        inf = infocent(netsym),
        flb = flowbet(netsym)
)
cor(df.prom)
##           deg       cls       btw       evc       inf       flb
## deg 1.0000000 0.6013689 0.5917256 0.6360877 0.7918289 0.5708101
## cls 0.6013689 1.0000000 0.8545112 0.4791390 0.8593100 0.8230555
## btw 0.5917256 0.8545112 1.0000000 0.2297788 0.7352932 0.9357088
## evc 0.6360877 0.4791390 0.2297788 1.0000000 0.7469055 0.3381616
## inf 0.7918289 0.8593100 0.7352932 0.7469055 1.0000000 0.7994418
## flb 0.5708101 0.8230555 0.9357088 0.3381616 0.7994418 1.0000000
# Tabular visualization for multiple centrality measures
# Defining a data frame in which is computed the centrality for all nodes using
# multiple methods
df.prom2 <- data.frame(
        name = network.vertex.names(netsym),
        degree = degree(netsym, gmode="graph"),
        closeness = closeness(netsym, gmode="graph"),
        betweenness = betweenness(netsym, gmode="graph"))
df.promsort <- df.prom2[order(-df.prom2$degree),]
cd <- centralization(netsym,degree)
cc <- centralization(netsym,closeness)
cb <- centralization(netsym,betweenness)
df.promsort <- rbind(df.promsort,data.frame(
        name = "Centralization level",
        degree = cd,
        closeness = cc,
        betweenness = cb
))
df.promsort
##                     name    degree closeness betweenness
## 8           T**a G***ghe 7.0000000 0.4166667  51.0000000
## 1          B***cu L***na 6.0000000 0.4761905 113.1666667
## 9            S**m An**la 6.0000000 0.4081633  36.0000000
## 19            D**a I***l 6.0000000 0.3846154  69.4000000
## 5            M**tu M**na 5.0000000 0.3278689   9.6666667
## 6           Ma**u I***he 5.0000000 0.3278689   9.6666667
## 12           M***u L**do 5.0000000 0.2564103   7.0000000
## 3         B**scu C***nel 4.0000000 0.3846154   4.1666667
## 7              T**a F**p 3.0000000 0.3174603   0.0000000
## 13             D**a D**a 3.0000000 0.3636364  16.6000000
## 14             D**a C**l 3.0000000 0.4444444  96.0000000
## 2         B***cu An***us 2.0000000 0.3333333   0.0000000
## 10        G**ca G****ghe 2.0000000 0.2531646   0.0000000
## 11             C**u I**n 2.0000000 0.2941176   3.6000000
## 15            N**cu P**u 2.0000000 0.2941176   2.8500000
## 16           N**se T**er 2.0000000 0.2941176   2.8500000
## 17        S***an C***tin 2.0000000 0.2941176   2.8500000
## 18           O***u A**ei 2.0000000 0.2941176   2.8500000
## 20           P**ci V***e 2.0000000 0.3076923   0.1666667
## 21          D***mir R**a 2.0000000 0.3076923   0.1666667
## 4          B**hiu G***ge 1.0000000 0.3278689   0.0000000
## 110 Centralization level 0.1973684 0.1518153   0.5127632
# Cutpoints are nodes that if removed will affect the conectivity of the network
# In the graphic below, it is displayed with green the cutpoint nodes.
cpnet <- cutpoints(netsym,mode="graph",return.indicator=TRUE)
gplot(netsym,gmode="graph",vertex.cex=cpnet+2,vertex.col=cpnet+2,jitter=FALSE,
      displaylabels=TRUE,label=netsym %v% "abrev_name")

# Bridges are edges that if removed will affect the conectivity of the network
# In the graphic below it is displayed with green the edges that are bridges.
bridges <- function(dat,mode="graph",connected=c("strong", "weak")) {
        e_cnt <- network.edgecount(dat)
        if (mode == "graph") {
                cmp_cnt <- components(dat)
                b_vec <- rep(FALSE,e_cnt)
                for(i in 1:e_cnt){
                        dat2 <- dat
                        delete.edges(dat2,i)
                        b_vec[i] <- (components(dat2) != cmp_cnt)
                }
        }
        else {
                cmp_cnt <- components(dat,connected=connected)
                b_vec <- rep(FALSE,e_cnt)
                for(i in 1:e_cnt){
                        dat2 <- dat
                        delete.edges(dat2,i)
                        b_vec[i] <- (components(dat2,connected=connected) != cmp_cnt)
                }
        }
        return (b_vec)
}
bridges(netsym)
##  [1] FALSE FALSE  TRUE FALSE FALSE  TRUE FALSE FALSE FALSE FALSE FALSE FALSE
## [13]  TRUE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
## [25] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
## [37] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
## [49] FALSE FALSE FALSE  TRUE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
## [61] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
brnet <- bridges(netsym)
gplot(netsym,gmode="graph",vertex.col="red",edge.col=brnet+2,jitter=FALSE,
      displaylabels=TRUE,label=netsym %v% "abrev_name",edge.lwd=3*brnet+2)

Chapter 8

## Setup
### Import igraph for this part of the project
library(igraph)
## 
## Attaching package: 'igraph'
## The following objects are masked from 'package:sna':
## 
##     betweenness, bonpow, closeness, components, degree, dyad.census,
##     evcent, hierarchy, is.connected, neighborhood, triad.census
## The following objects are masked from 'package:network':
## 
##     %c%, %s%, add.edges, add.vertices, delete.edges, delete.vertices,
##     get.edge.attribute, get.edges, get.vertex.attribute, is.bipartite,
##     is.directed, list.edge.attributes, list.vertex.attributes,
##     set.edge.attribute, set.vertex.attribute
## The following objects are masked from 'package:stats':
## 
##     decompose, spectrum
## The following object is masked from 'package:base':
## 
##     union
library(intergraph)
### Transfer network from statnet format to igraph format
inetsym <- as.undirected(asIgraph(netsym))
V(inetsym)$name <- netsym %v% "abrev_name"
V(inetsym)$fullname <- network.vertex.names(netsym)
V(inetsym)$role <- rolecat

## Cliques
### Determine the cliques from the network as well as the biggest clique.
clique.number(inetsym)
## [1] 4
cliques(inetsym, min=3)
## [[1]]
## + 3/21 vertices, named, from 71bf4e3:
## [1] MI TF TG
## 
## [[2]]
## + 3/21 vertices, named, from 71bf4e3:
## [1] DD DC DI
## 
## [[3]]
## + 3/21 vertices, named, from 71bf4e3:
## [1] BL BA BC
## 
## [[4]]
## + 3/21 vertices, named, from 71bf4e3:
## [1] BL BC SA
## 
## [[5]]
## + 3/21 vertices, named, from 71bf4e3:
## [1] BL BC TG
## 
## [[6]]
## + 3/21 vertices, named, from 71bf4e3:
## [1] MM MI TF
## 
## [[7]]
## + 4/21 vertices, named, from 71bf4e3:
## [1] MM MI TF TG
## 
## [[8]]
## + 3/21 vertices, named, from 71bf4e3:
## [1] MM MI GG
## 
## [[9]]
## + 3/21 vertices, named, from 71bf4e3:
## [1] MM MI SA
## 
## [[10]]
## + 3/21 vertices, named, from 71bf4e3:
## [1] MM MI TG
## 
## [[11]]
## + 3/21 vertices, named, from 71bf4e3:
## [1] MM TF TG
maximal.cliques(inetsym, min=3)
## [[1]]
## + 3/21 vertices, named, from 71bf4e3:
## [1] BA BL BC
## 
## [[2]]
## + 3/21 vertices, named, from 71bf4e3:
## [1] DC DD DI
## 
## [[3]]
## + 3/21 vertices, named, from 71bf4e3:
## [1] GG MM MI
## 
## [[4]]
## + 4/21 vertices, named, from 71bf4e3:
## [1] TF MM TG MI
## 
## [[5]]
## + 3/21 vertices, named, from 71bf4e3:
## [1] MM MI SA
## 
## [[6]]
## + 3/21 vertices, named, from 71bf4e3:
## [1] BC BL TG
## 
## [[7]]
## + 3/21 vertices, named, from 71bf4e3:
## [1] BC BL SA
largest.cliques(inetsym)
## [[1]]
## + 4/21 vertices, named, from 71bf4e3:
## [1] TG MM MI TF
## k-Cores
coreness <- graph.coreness(inetsym)
table(coreness)
## coreness
##  1  2  3 
##  1 13  7
maxCoreness <- max(coreness)
maxCoreness
## [1] 3
colors <- rainbow(maxCoreness)
plot(inetsym,vertex.label=coreness,vertex.color=colors[coreness],layout=layout_with_fr)

i1_3 <- inetsym
i2_3 <- induced.subgraph(inetsym, vids=which(coreness > 1))
i3_3 <- induced.subgraph(inetsym, vids=which(coreness > 2))
lay <- layout.fruchterman.reingold(inetsym)
op <- par(mfrow=c(1,3),mar = c(3,0,2,0))
plot(i1_3,layout=lay,vertex.label=coreness,vertex.color=colors[coreness],main="All k-cores")
plot(i2_3,layout=lay[which(coreness > 1),],vertex.label=coreness[which(coreness > 1)],vertex.color=colors[coreness[which(coreness > 1)]],main="k-cores 2-3")
plot(i3_3,layout=lay[which(coreness > 2),],vertex.label=coreness[which(coreness > 2)],vertex.color=colors[coreness[which(coreness > 2)]],main="k-cores 3")

par(op)

## Modularity is a measure that describes how good is a network clusterization
colors <- brewer.pal(5,"Dark2")
roles <- c("C","CR","CT","A","D")
V(inetsym)[V(inetsym)$role == "C"]$color <- colors[1]
V(inetsym)[V(inetsym)$role == "CR"]$color <- colors[2]
V(inetsym)[V(inetsym)$role == "CT"]$color <- colors[3]
V(inetsym)[V(inetsym)$role == "A"]$color <- colors[4]
V(inetsym)[V(inetsym)$role == "D"]$color <- colors[5]

V(inetsym)[V(inetsym)$role == "C"]$group <- 1
V(inetsym)[V(inetsym)$role == "CR"]$group <- 2
V(inetsym)[V(inetsym)$role == "CT"]$group <- 3
V(inetsym)[V(inetsym)$role == "A"]$group <- 4
V(inetsym)[V(inetsym)$role == "D"]$group <- 5

op <- par(mfrow=c(1,1))
plot(inetsym,vertex.color=V(inetsym)$color,vertex.size=10)

## Modularity based on the role of each person
modularity(inetsym, V(inetsym)$group)
## [1] 0
## The result is smaller than 0, which means a bad clusterization result using this method

## Community detection algorithms
cw <- cluster_walktrap(inetsym)
modularity(cw)
## [1] 0.4903549
membership(cw)
## BL BA BC BG MM MI TF TG SA GG CI ML DD DC NP NT SC OA DI PV DR 
##  3  3  3  3  2  2  2  2  2  2  1  1  1  1  1  1  1  1  1  2  2
ceb <- cluster_edge_betweenness(inetsym)
modularity(ceb)
## [1] 0.4903549
membership(ceb)
## BL BA BC BG MM MI TF TG SA GG CI ML DD DC NP NT SC OA DI PV DR 
##  1  1  1  1  2  2  2  2  2  2  3  3  3  3  3  3  3  3  3  2  2
cs <- cluster_spinglass(inetsym)
modularity(cs)
## [1] 0.4753086
membership(cs)
## BL BA BC BG MM MI TF TG SA GG CI ML DD DC NP NT SC OA DI PV DR 
##  3  3  3  3  1  1  1  1  1  1  2  2  2  3  2  2  2  2  2  1  1
cfg <- cluster_fast_greedy(inetsym)
modularity(cfg)
## [1] 0.4695216
membership(cfg)
## BL BA BC BG MM MI TF TG SA GG CI ML DD DC NP NT SC OA DI PV DR 
##  1  1  1  1  3  3  3  3  1  3  2  2  2  2  2  2  2  2  2  1  1
clp <- cluster_label_prop(inetsym)
modularity(clp)
## [1] 0.4409722
membership(clp)
## BL BA BC BG MM MI TF TG SA GG CI ML DD DC NP NT SC OA DI PV DR 
##  1  1  1  1  1  1  1  1  1  1  2  2  2  2  2  2  2  2  2  1  1
cle <- cluster_leading_eigen(inetsym)
modularity(cle)
## [1] 0.464892
membership(cle)
## BL BA BC BG MM MI TF TG SA GG CI ML DD DC NP NT SC OA DI PV DR 
##  1  1  1  1  3  3  3  3  1  3  2  2  2  2  2  2  2  2  2  3  3
cl <- cluster_louvain(inetsym)
modularity(cl)
## [1] 0.4903549
membership(cl)
## BL BA BC BG MM MI TF TG SA GG CI ML DD DC NP NT SC OA DI PV DR 
##  3  3  3  3  1  1  1  1  1  1  2  2  2  2  2  2  2  2  2  1  1
table(V(inetsym)$role,membership(cw))
##    
##     1 2 3
##   1 2 0 0
##   2 6 3 3
##   3 0 0 1
##   4 1 3 0
##   5 0 2 0
compare(as.numeric(factor(V(inetsym)$role)),cw,method="adjusted.rand")
## [1] 0.02816901
compare(cw,ceb,method="adjusted.rand")
## [1] 1
compare(cw,cs,method="adjusted.rand")
## [1] 0.8695652
compare(cw,cfg,method="adjusted.rand")
## [1] 0.7075812
op <- par(mfrow=c(3,2),mar=c(3,0,2,0))
plot(ceb, inetsym,vertex.label=V(inetsym)$name,main="Edge Betweenness")
plot(cfg, inetsym,vertex.label=V(inetsym)$name,main="Fastgreedy")
plot(clp, inetsym,vertex.label=V(inetsym)$name,main="Label Propagation")
plot(cle, inetsym,vertex.label=V(inetsym)$name,main="Leading Eigenvector")
plot(cs, inetsym,vertex.label=V(inetsym)$name,main="Spinglass")
plot(cw, inetsym,vertex.label=V(inetsym)$name,main="Walktrap")

par(op)

Chapter 10

## Trying to generate a similar network using Erdos-Renyi method
no_nodes <- length(V(inetsym))
no_edges <- length(E(inetsym))
generated_network <- erdos.renyi.game(n=no_nodes,no_edges,type='gnm')
op <- par(mfrow=c(1,2))
plot(inetsym,vertex.label=NA,vertex.size=5)
plot(generated_network, vertex.label=NA, vertex.size=5)

par(op)

## Trying to generate a similar network using Small-World Model
avg_degree <- no_edges/no_nodes*2
g1 <- watts.strogatz.game(dim=1, size=no_nodes, nei=avg_degree/2, p=.05)
g2 <- watts.strogatz.game(dim=1, size=no_nodes, nei=avg_degree/2, p=.15)
g3 <- watts.strogatz.game(dim=1, size=no_nodes, nei=avg_degree/2, p=.30)
op <- par(mfrow=c(2,2))
plot(inetsym,vertex.label=NA,vertex.size=5)
plot(g1, vertex.label=NA, vertex.size=5)
plot(g2, vertex.label=NA, vertex.size=5)
plot(g3, vertex.label=NA, vertex.size=5)

par(op)

## Trying to generate a similar network using Scale-Free Model
barabasi_network <- barabasi.game(no_nodes, directed=FALSE)
op <- par(mfrow=c(1,2))
plot(inetsym,vertex.label=NA, vertex.size=5)
plot(barabasi_network,vertex.label=NA, vertex.size=5)

par(op)


## Comparing random models with the empirical network
list_network <- c(generated_network, g2, barabasi_network, inetsym)
comparison_table <- data.frame(
  Name = c("Erdos-Renyi", "Small world", "Scale-free model", "Empiric network"),
  Size = c(length(V(generated_network)), length(V(g2)), length(V(barabasi_network)), length(V(inetsym))),
  Density = c(gden(asNetwork(generated_network)),gden(asNetwork(g2)),gden(asNetwork(barabasi_network)),gden(asNetwork(inetsym))),
  Avg_Degree = c(length(E(generated_network))/length(V(generated_network)),length(E(g2))/length(V(g2)),length(E(barabasi_network))/length(V(barabasi_network)),length(E(inetsym))/length(V(inetsym))),
  Transitivity = c(transitivity(generated_network), transitivity(g2), transitivity(barabasi_network), transitivity(inetsym)),
  Isolates = c(sum(degree(generated_network)==0),sum(degree(g2)==0),sum(degree(barabasi_network)==0),sum(degree(inetsym)==0))
)
comparison_table
##               Name Size   Density Avg_Degree Transitivity Isolates
## 1      Erdos-Renyi   21 0.1714286   1.714286    0.1061947        1
## 2      Small world   21 0.1000000   1.000000    0.0000000        1
## 3 Scale-free model   21 0.0952381   0.952381    0.0000000        0
## 4  Empiric network   21 0.1714286   1.714286    0.2500000        0